home *** CD-ROM | disk | FTP | other *** search
/ Aminet 6 / Aminet 6 - June 1995.iso / Aminet / dev / e / capus2.lha / capus2 / UserStartup / Sources / WBSelector.e < prev    next >
Encoding:
Text File  |  1995-03-31  |  10.8 KB  |  350 lines
  1. /*"Peps Header"*/
  2. /*=========================================================================================*/
  3. /* Source code generate by Gui2E v0.1 © 1994 NasGûl                                        */
  4. /*=========================================================================================*/
  5. /*======<<< Peps Header >>>======
  6.  PRGVERSION '0'
  7.  ================================
  8.  PRGREVISION '0'
  9.  ================================
  10.  AUTHOR      'NasGûl'
  11.  ===============================*/
  12. /*======<<<   History   >>>======
  13.  V 0.0 Chosse file in Sys:WBStartup
  14.  ===============================*/
  15. /**/
  16. OPT OSVERSION=37
  17. /*"Modules List"*/
  18. MODULE 'intuition/intuition','gadtools','libraries/gadtools','intuition/gadgetclass','intuition/screens',
  19.        'graphics/text','exec/lists','exec/nodes','exec/ports','eropenlib','utility/tagitem'
  20. MODULE 'dos/dos'
  21. /**/
  22. /*"PModules List"*/
  23. PMODULE 'WBSelectorList'
  24. /**/
  25. /*"Objects Definitions"*/
  26. OBJECT wbsbase
  27.     prgslist:LONG   /* List of prg selected */
  28.     prgdlist:LONG   /* List of prg deselcted */
  29. ENDOBJECT
  30. /**/
  31. /*"Globals Definitions"*/
  32. ENUM ER_NONE,ER_LOCKSCREEN,ER_VISUAL,ER_CONTEXT,ER_MENUS,ER_GADGET,ER_WINDOW,
  33.      ER_ONLYCLI,ER_BADARGS,ER_FATAL
  34. DEF screen:PTR TO screen,
  35.     visual=NIL,
  36.     tattr:PTR TO textattr,
  37.     reelquit=FALSE,
  38.     offy,offx
  39. /*=======================================
  40.  = wbs Definitions
  41.  =======================================*/
  42. DEF wbs_window=NIL:PTR TO window
  43. DEF wbs_glist=NIL
  44. /*==================*/
  45. /*     Gadgets      */
  46. /*==================*/
  47. CONST GA_G_SELECT=0
  48. CONST GA_G_DESELECT=1
  49. /*=============================
  50.  = Gadgets labels of wbs
  51.  =============================*/
  52. DEF g_select
  53. DEF g_deselect
  54. /*=============================
  55.  = Application def
  56.  =============================*/
  57.  DEF mywbs:PTR TO wbsbase
  58.  DEF count=5,intuicount,stopcount=FALSE
  59.  DEF winx,winy,savechange=FALSE
  60. /**/
  61. /*"Libraries Procedures"*/
  62. /*"p_OpenLibraries"*/
  63. PROC p_OpenLibraries() HANDLE
  64.     IF (intuitionbase:=OpenLibrary('intuition.library',37))=NIL THEN Raise(ER_INTUITIONLIB)
  65.     IF (gadtoolsbase:=OpenLibrary('gadtools.library',37))=NIL THEN Raise(ER_GADTOOLSLIB)
  66.     IF (gfxbase:=OpenLibrary('graphics.library',37))=NIL THEN Raise(ER_GRAPHICSLIB)
  67.     Raise(ER_NONE)
  68. EXCEPT
  69.     RETURN exception
  70. ENDPROC
  71. /**/
  72. /*"p_CloseLibraries"*/
  73. PROC p_CloseLibraries()
  74.     IF gfxbase THEN CloseLibrary(gfxbase)
  75.     IF gadtoolsbase THEN CloseLibrary(gadtoolsbase)
  76.     IF intuitionbase THEN CloseLibrary(intuitionbase)
  77. ENDPROC
  78. /**/
  79. /**/
  80. /*"Window Procedures"*/
  81. /*"p_SetUpScreen"*/
  82. PROC p_SetUpScreen() HANDLE
  83.     IF (screen:=LockPubScreen('Workbench'))=NIL THEN Raise(ER_LOCKSCREEN)
  84.     IF (visual:=GetVisualInfoA(screen,NIL))=NIL THEN Raise(ER_VISUAL)
  85.     offy:=screen.wbortop+Int(screen.rastport+58)-10
  86.     Raise(ER_NONE)
  87. EXCEPT
  88.     RETURN exception
  89. ENDPROC
  90. /**/
  91. /*"p_SetDownScreen"*/
  92. PROC p_SetDownScreen()
  93.     IF visual THEN FreeVisualInfo(visual)
  94.     IF screen THEN UnlockPubScreen(NIL,screen)
  95. ENDPROC
  96. /**/
  97. /*"p_InitwbsWindow"*/
  98. PROC p_InitwbsWindow() HANDLE
  99.     DEF g:PTR TO gadget
  100.     IF (g:=CreateContext({wbs_glist}))=NIL THEN Raise(ER_CONTEXT)
  101.     IF (g_select:=CreateGadgetA(LISTVIEW_KIND,g,[offx+24,offy+28,153,40,'Selected',tattr,0,4,visual,0]:newgadget,[GTLV_LABELS,NIL,GT_UNDERSCORE,"_",TAG_DONE]))=NIL THEN Raise(ER_GADGET)
  102.     IF (g_deselect:=CreateGadgetA(LISTVIEW_KIND,g_select,[offx+180,offy+28,153,40,'DeSelected',tattr,1,4,visual,0]:newgadget,[GTLV_LABELS,NIL,GT_UNDERSCORE,"_",TAG_DONE]))=NIL THEN Raise(ER_GADGET)
  103.     Raise(ER_NONE)
  104. EXCEPT
  105.     RETURN exception
  106. ENDPROC
  107. /**/
  108. /*"p_RenderwbsWindow"*/
  109. PROC p_RenderwbsWindow()
  110.     IF p_EmptyList(mywbs.prgslist)<>-1
  111.         Gt_SetGadgetAttrsA(g_select,wbs_window,NIL,[GA_DISABLED,FALSE,GTLV_LABELS,mywbs.prgslist,TAG_DONE])
  112.     ELSE
  113.         Gt_SetGadgetAttrsA(g_select,wbs_window,NIL,[GA_DISABLED,TRUE,GTLV_LABELS,NIL,TAG_DONE])
  114.     ENDIF
  115.     IF p_EmptyList(mywbs.prgdlist)<>-1
  116.         Gt_SetGadgetAttrsA(g_deselect,wbs_window,NIL,[GA_DISABLED,FALSE,GTLV_LABELS,mywbs.prgdlist,TAG_DONE])
  117.     ELSE
  118.         Gt_SetGadgetAttrsA(g_deselect,wbs_window,NIL,[GA_DISABLED,TRUE,GTLV_LABELS,NIL,TAG_DONE])
  119.     ENDIF
  120.     DrawBevelBoxA(wbs_window.rport,offx+8,offy+12,341,61,[GT_VISUALINFO,visual,TAG_DONE])
  121.     RefreshGList(g_select,wbs_window,NIL,-1)
  122.     Gt_RefreshWindow(wbs_window,NIL)
  123. ENDPROC
  124. /**/
  125. /*"p_OpenwbsWindow"*/
  126. PROC p_OpenwbsWindow() HANDLE
  127.     IF (wbs_window:=OpenWindowTagList(NIL,
  128.                       [WA_LEFT,winx,
  129.                        WA_TOP,winy,
  130.                        WA_WIDTH,offx+356,
  131.                        WA_HEIGHT,offy+75,
  132.                        WA_IDCMP,$400278,
  133.                        WA_FLAGS,$102E,
  134.                        WA_GADGETS,wbs_glist,
  135.                        WA_CUSTOMSCREEN,screen,
  136.                        WA_TITLE,'WBStartup Selector © 1994 NasGûl',
  137.                        WA_SCREENTITLE,'Made With GadToolsBox V2.0b © 1991-1993',
  138.                        TAG_DONE]))=NIL THEN Raise(ER_WINDOW)
  139.     p_RenderwbsWindow()
  140.     Raise(ER_NONE)
  141. EXCEPT
  142.     RETURN exception
  143. ENDPROC
  144. /**/
  145. /*"p_RemwbsWindow"*/
  146. PROC p_RemwbsWindow()
  147.     IF wbs_window THEN CloseWindow(wbs_window)
  148.     IF wbs_glist THEN FreeGadgets(wbs_glist)
  149. ENDPROC
  150. /**/
  151. /**/
  152. /*"Message Procedures"*/
  153. /*"p_LookAllMessage"*/
  154. PROC p_LookAllMessage()
  155.     DEF sigreturn
  156.     DEF wbsport:PTR TO mp
  157.     IF wbs_window THEN wbsport:=wbs_window.userport ELSE wbsport:=NIL
  158.     sigreturn:=Wait(Shl(1,wbsport.sigbit) OR
  159.                     $F000)
  160.     IF (sigreturn AND Shl(1,wbsport.sigbit))
  161.         p_LookwbsMessage()
  162.     ENDIF
  163.     IF (sigreturn AND $F000)
  164.         reelquit:=TRUE
  165.     ENDIF
  166. ENDPROC
  167. /**/
  168. /*"p_LookwbsMessage"*/
  169. PROC p_LookwbsMessage()
  170.    DEF mes:PTR TO intuimessage
  171.    DEF g:PTR TO gadget
  172.    DEF type=0,infos=NIL
  173.    DEF curnode:PTR TO ln
  174.    WHILE mes:=Gt_GetIMsg(wbs_window.userport)
  175.        type:=mes.class
  176.        SELECT type
  177.            CASE IDCMP_CLOSEWINDOW
  178.               reelquit:=TRUE
  179.            CASE IDCMP_INTUITICKS
  180.               IF stopcount=FALSE
  181.                   INC intuicount
  182.                   IF intuicount=count THEN reelquit:=TRUE
  183.               ENDIF
  184.            CASE IDCMP_GADGETUP
  185.             /*IDCMP_GADGETUP*/
  186.               g:=mes.iaddress
  187.               infos:=g.gadgetid
  188.               SELECT infos
  189.                   CASE GA_G_SELECT
  190.                     curnode:=p_GetAdrNode(mywbs.prgslist,mes.code)
  191.                     p_AjouteNode(mywbs.prgdlist,curnode.name,NIL)
  192.                     p_EnleveNode(mywbs.prgslist,mes.code,0,0)
  193.                     p_RenderwbsWindow()
  194.                     savechange:=TRUE
  195.                   CASE GA_G_DESELECT
  196.                     curnode:=p_GetAdrNode(mywbs.prgdlist,mes.code)
  197.                     p_AjouteNode(mywbs.prgslist,curnode.name,NIL)
  198.                     p_EnleveNode(mywbs.prgdlist,mes.code,0,0)
  199.                     p_RenderwbsWindow()
  200.                     savechange:=TRUE
  201.               ENDSELECT
  202.               stopcount:=TRUE
  203.        ENDSELECT
  204.        Gt_ReplyIMsg(mes)
  205.    ENDWHILE
  206. ENDPROC
  207. /**/
  208. /**/
  209. /*"Applications Procedures"*/
  210. /*"p_InitWBS()"*/
  211. PROC p_InitWBS() HANDLE
  212.     mywbs:=New(SIZEOF wbsbase)
  213.     mywbs.prgslist:=p_InitList()
  214.     mywbs.prgdlist:=p_InitList()
  215.     Raise(ER_NONE)
  216. EXCEPT
  217.     RETURN exception
  218. ENDPROC
  219. /**/
  220. /*"p_RemWBS()"*/
  221. PROC p_RemWBS()
  222.     IF mywbs.prgslist THEN p_CleanList(mywbs.prgslist,0,0,LIST_REMOVE)
  223.     IF mywbs.prgdlist THEN p_CleanList(mywbs.prgdlist,0,0,LIST_REMOVE)
  224.     IF mywbs THEN Dispose(mywbs)
  225. ENDPROC
  226. /**/
  227. /*"p_ReadWBStartupDir()"*/
  228. PROC p_ReadWBStartupDir() HANDLE
  229.     DEF lock
  230.     DEF info:fileinfoblock
  231.     DEF pos
  232.     DEF prgname[80]:STRING
  233.     DEF file[80]:STRING
  234.     IF lock:=Lock('Sys:WBStartup',-2)
  235.         IF Examine(lock,info)
  236.             WHILE ExNext(lock,info)
  237.                 StringF(file,'\s',info.filename)
  238.                 IF (pos:=InStr(file,'.info',ALL))<>-1
  239.                     MidStr(prgname,file,0,pos)
  240.                     p_AjouteNode(mywbs.prgslist,prgname,NIL)
  241.                 ENDIF
  242.                 IF (pos:=InStr(file,'.xinfo',ALL))<>-1
  243.                     MidStr(prgname,file,0,pos)
  244.                     p_AjouteNode(mywbs.prgdlist,prgname,NIL)
  245.                 ENDIF
  246.                 pos:=-1
  247.             ENDWHILE
  248.         ENDIF
  249.         IF lock THEN UnLock(lock)
  250.     ELSE
  251.         Raise(ER_FATAL)
  252.     ENDIF
  253.     Raise(ER_NONE)
  254. EXCEPT
  255.     RETURN exception
  256. ENDPROC
  257. /**/
  258. /*"p_MakeChange()"*/
  259. PROC p_MakeChange()
  260.     DEF list:PTR TO lh
  261.     DEF n:PTR TO ln
  262.     DEF source[80]:STRING
  263.     DEF destin[80]:STRING
  264.     list:=mywbs.prgslist
  265.     n:=list.head
  266.     WHILE n
  267.         IF n.succ<>0
  268.             StringF(source,'Sys:WBStartUp/\s.xinfo',n.name)
  269.             IF FileLength(source)<>-1
  270.                 StringF(destin,'Sys:WBStartup/\s.info',n.name)
  271.                 Rename(source,destin)
  272.             ENDIF
  273.         ENDIF
  274.         n:=n.succ
  275.     ENDWHILE
  276.     list:=mywbs.prgdlist
  277.     n:=list.head
  278.     WHILE n
  279.         IF n.succ<>0
  280.             StringF(source,'Sys:WBStartUp/\s.info',n.name)
  281.             IF FileLength(source)<>-1
  282.                 StringF(destin,'Sys:WBStartup/\s.xinfo',n.name)
  283.                 Rename(source,destin)
  284.             ENDIF
  285.         ENDIF
  286.         n:=n.succ
  287.     ENDWHILE
  288. ENDPROC
  289. /**/
  290. /*"p_StartCli()"*/
  291. PROC p_StartCli() HANDLE
  292.     DEF myargs:PTR TO LONG,rdargs=NIL
  293.     myargs:=[0,0,0]
  294.     IF rdargs:=ReadArgs('Time/N,PosX/N,PosY/N',myargs,NIL)
  295.         IF myargs[0]
  296.             count:=Long(myargs[0])*5
  297.         ELSE
  298.             count:=5
  299.         ENDIF
  300.         IF myargs[1] THEN winx:=Long(myargs[1]) ELSE winx:=300
  301.         IF myargs[2] THEN winy:=Long(myargs[2]) ELSE winy:=65
  302.     ELSE
  303.         Raise(ER_BADARGS)
  304.     ENDIF
  305.     Raise(ER_NONE)
  306. EXCEPT
  307.     IF rdargs THEN FreeArgs(rdargs)
  308.     RETURN exception
  309. ENDPROC
  310. /**/
  311. /**/
  312. /*"main"*/
  313. PROC main() HANDLE
  314.     DEF testmain
  315.     tattr:=['topaz.font',8,0,0]:textattr
  316.     IF (testmain:=p_OpenLibraries())<>ER_NONE THEN Raise(testmain)
  317.     IF wbmessage<>NIL
  318.         Raise(ER_ONLYCLI)
  319.     ELSE
  320.         IF (testmain:=p_StartCli())<>ER_NONE THEN Raise(testmain)
  321.     ENDIF
  322.     IF (testmain:=p_InitWBS())<>ER_NONE THEN Raise(testmain)
  323.     IF (testmain:=p_ReadWBStartupDir())<>ER_NONE THEN Raise(testmain)
  324.     IF (testmain:=p_SetUpScreen())<>ER_NONE THEN Raise(testmain)
  325.     IF (testmain:=p_InitwbsWindow())<>ER_NONE THEN Raise(testmain)
  326.     IF (testmain:=p_OpenwbsWindow())<>ER_NONE THEN Raise(testmain)
  327.     REPEAT
  328.         p_LookAllMessage()
  329.     UNTIL reelquit=TRUE
  330.     IF savechange=TRUE THEN p_MakeChange()
  331.     Raise(ER_NONE)
  332. EXCEPT
  333.     IF mywbs THEN p_RemWBS()
  334.     IF wbs_window THEN p_RemwbsWindow()
  335.     IF screen THEN p_SetDownScreen()
  336.     p_CloseLibraries()
  337.     SELECT exception
  338.         CASE ER_LOCKSCREEN; WriteF('Lock Screen Failed.\n')
  339.         CASE ER_VISUAL;     WriteF('Error Visual.\n')
  340.         CASE ER_CONTEXT;    WriteF('Error Context.\n')
  341.         CASE ER_MENUS;      WriteF('Error Menus.\n')
  342.         CASE ER_GADGET;     WriteF('Error Gadget.\n')
  343.         CASE ER_WINDOW;     WriteF('Error Window.\n')
  344.         CASE ER_ONLYCLI;    WriteF('Only Cli.\n')
  345.         CASE ER_BADARGS;    WriteF('Bad Args.\n')
  346.         CASE ER_FATAL;      WriteF('Fatal Error.\n')
  347.     ENDSELECT
  348. ENDPROC
  349. /**/
  350.